00010	C***** SUBRS RHYTH, SETUP,MARKS  ********
00020	
00100		SUBROUTINE RHYTH
00200		DIMENSION RPOS(2,40),R(8,100)
00300		COMMON /XRN/RN(4000)
00400		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00500		COMMON /SCX/RHY(4),JALPHA(12),JX,JXX,JZ,IRHY,JD,KA,KB,IZ
00600		COMMON /STF/RSTFAC(8),RSTJC
00700		COMMON /SC/J,L,MK
00800		1 ,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,IXX,ISEMI,IQT
00900		1 ,VX(50),IAMP,K,KN,M,MODE,IBLA
01000		COMMON /POS/POS1,POS2
01100		EQUIVALENCE (RPOS(1,1),RN(3921)),(VX(1),X),(VX(2),Y),(VX(7)
01200		1,Z),(VX(3),AB),(VX(4),T),(VX(5),RB),(VX(6),X2),(SIZ,KN)
01300		1,(VX(8),C),(VX(9),S),(VX(10),X3),(SET4,RN(3920)),(RA,RN(3919))
01350		1,(R,RN(3001))
01400	
01500	CC THIS IS NOW IN NOTES 	CALL SETUP
01600		NX=-1
01700		JX=0
01800		NOTE=0
01900		Y=0
02000		JSET=0
02100	C  NEG. IF SETUP IS NOT READY
02200		IF(RPOS(1,1))GO TO 341
02250		KZ=1
02300		JSET=-1
02310		DO 9 KX=1,40
02320	9	IF(RPOS(2,KX).GT.0)GO TO 10
02400	10	AVGPOS=RPOS(1,KX)
02500		RLPOS=AVGPOS
02510		KX=KX+1
02600		RLP2=RPOS(1,KX)
02700	343	AVP2=RPOS(2,KX)-.001
02710		IF(AVP2.GT.0)GO TO 341
02720		KX=KX+1
02730		GO TO 343
02800	C  AVERAGED AND REAL POSITIONS FROM 'SETUP'
03000	341	DO 34 K=1,IRHY
03100	34	IF(V(K).GT..05)Y=ABS(V(K))+Y
03150	C  99TH NOTES ARE TAKEN AS GRACE NOTES.
03200	C  Y=TOTAL TIME
03300		Z=POS2-POS1
03400		ZX=Z
03410		IF(JSET)GO TO 3421
03500	342	DO 1 K=1,IZ
03600		X=R(1,K)
03700		IF(X.LT.3.)GO TO 1
03800	C  JUMP IF NOTE OR REST
03900		IF(X.NE.7.)GO TO 8
04000	C   JUMP IF NOT A KEY SIG.
04100		RA=2.+ABS(R(4,K))*2.0
04200		GO TO 6
04300	8	IF(X.NE.4.)GO TO 81
04400	C   NEXT IS FOR BAR LINES
04500		RA=3.5
04600		RE=R(1,K+1)
04700		IF(RE.EQ.3.)RA=1.5
04800	C  A CLEF
04900		IF(RE.EQ.18)RA=2.5
05000	C  A METER
05100	C  NEXT IS NOT A NOTE OR REST
05200	83	IF(K.EQ.IZ)RA=0
05300	C  END OF STAFF
05400		GO TO 6
05500	82	RA=6
05600		GO TO 83
05700	81	IF(X.EQ.18)GO TO 82
05800		RA=8.
05900	C   FOR CLEFS
06000		IF(K.LT.3)RA=10.
06100	C   THE FIRST CLEF IS NOT MINI
06200	6	RA=RA*RSTJC
06300	C  SO SPACE WILL DEPEND ON SIZE OF STAFF
06400		Z=Z-RA
06500		R(8,K)=RA
06600	C   STORES SPACE NUM THAT MUST BE GIVEN BACK
06700	1	CONTINUE
06800	C   SUBTRACTS SPACE FOR CLEF OR BAR.  WILL ADD BOTH LATER.
06900	C  POS1 AND Z ARE FOR RHYTHMIC SPACING
07000	CC	ZZ=ZX-Z
07100	C  SPACE FOR NON-NOTES
07150	134	FORMAT(' **** MISMATCH WITH STF.4 ****')
07200	3421	K=0
07250		IF(Y.NE.RA.AND.JSET)TYPE 134
07300	
07400	C   LOOP TO END
07500	3	K=K+1
07600	C   K IS COUNTER
07610		R(6,K)=0
07620		R(7,K)=0
07700		RE=R(1,K)
07900		IF(RE.LE.2.)GO TO 2
08000		RD=R(8,K)
08100		R(8,K)=0
08300		IF(JSET)GO TO 71
08400	7	IF(K.EQ.IZ)POS1=POS2
08500		IF(R(1,K-1).GT.2..OR.K.EQ.1.OR.RE.EQ.4.)GO TO 73
08600		Z=Z+RD/3.
08700	C   RETURNS 1/3 OF THE SPACE IF PREV. ITEM IS NOTE OR REST
08800		POS1=POS1-RD/3
08900	C  THIS CAN RESULT IN OVERLAP WHICH MUST BE EDITED OUT.!!
09000	73	R(2,K)=POS1
09002	72	POS1=POS1+RD
09004	C   ABOVE SECTION LEAVES ROOM FOR CLEF OR BAR
09006		GO TO 334
09010	71	DO 74 J=KZ,40
09012	74	IF(RE.EQ.-RPOS(2,J))GO TO 75
09014		POS=R(2,K-1)+4
09015		GO TO 76
09016	75	POS=RPOS(1,J)
09018		KZ=J+1
09020	C  FOUND SAME TYPE OF ITEM.
09030	76	R(2,K)=POS
09040		GO TO 334
09500	
09600	2	JX=JX+1
09700	21	AB=ABS(V(JX))
09710		IF(AB.GT..05)GO TO 210
09720		R(2,K)=-1.
09723		RA=100
09726		IF(R(4,K))RA=-RA
09730		R(4,K)=R(4,K)+RA
09740		R(7,K)=1.9
09742	C  1.9 IN P7 PUTS IN SLASH ON TAIL
09745	C  FOUND A GRACE NOTE
09750		GO TO 334
09800	210	RB=0
09810		IF(JSET.GE.0.AND.SET4.LT.0)R(8,K)=-AB
09820	C  FOR AUTOMATIC SETUP
09900		JZ=K
10000	C  JZ WILL BE USED NEAR END
10100	3634	IF(AMOD(AB,.1875).EQ.0)GO TO 122
10200	C  .1875 FINDS SINGLE DOTS ON NOTES
10210		IF(AMOD(AB,.4375).NE.0)GO TO 22
10220		T=2
10230		GO TO 322
10240	122	T=1
10300	322	IF(RE.EQ.2.)GO TO 35
10400		R(7,K)=R(7,K)+10.*T
10410	C  PUTS ONE OR TWO DOTS
10500	C  DOTS THE NOTE.
10600		GO TO 36
10700	
10800	35	R(6,K)=T
10900	C  ADDS DOT TO REST.
11000	36	RB=AB/3.
11010		IF(T.NE.1)RB=(4*AB)/7
11100	C  TO KEEP TAIL ON DOTTED NOTE
11200	
11400	22	POS=POS1
11500		IF(JSET.EQ.0)GO TO 220
11600	222	IF(NOTE)GO TO 223
11700	C  FIRST TIME A NOTE IS FOUND.
11800		NOTE=-1
11900		POS1=RLPOS
12200		Z=POS2-POS1
12300	C  RESETS SPACE AVAILABLE, ZZ IS SPACE FOR NON-NOTES
12400	223	IF(POS1.LT.AVP2)GO TO 221
12500	224	KX=KX+1
12510	C???? OCT, 73	 	IF(NX.EQ.0)GO TO 225
12600	CC	AVGPOS=AVP2
12700	CC	RLPOS=RLP2
12800		IF(NX)RLP2=RPOS(1,KX)
12900		NX=-1
12910	225	IF(RPOS(2,KX-1))GO TO 227
12955		RLPOS=RPOS(1,KX-1)
12977		AVGPOS=AVP2
12980	227	AVP2=RPOS(2,KX)-.001
13000		IF(AVP2.GT.0)GO TO 223
13100	C  0 IN RPOS=POS. OF NON-NOTE
13200		IF(RLP2.GE.POS1)NX=0
13300		GO TO 224
13400	221	POS=(POS1-AVGPOS)*(RLP2-RLPOS)/(AVP2-AVGPOS)+RLPOS
13500	CCC	NX=-1
13600	220	R(2,K)=POS
13700	CC	IF(RE.GT.2)GO TO 72
13800	4634	IF((AB.GE.2.OR.AB.EQ.1.333333333).AND.RE.EQ.1
13850		1 .AND.R(6,K).EQ.0)R(6,K)=-1.
13875	C 'WHITENS' HALF, WHOLE AND TRIPLET HALF NOTES.
13900		L=K+1
14000	2634	IF(R(8,L).GE.0.OR.R(1,L).NE.1.)GO TO 1634
14100	C   JUMP IF NOT DOUBLE STOP
14200		IF(AB.GE.4)R(5,K)=AMOD(R(5,K),10.0)
14300	C  DELETES STEM FROM WHOLE NOTE CHORD
14400		R(2,L)=R(2,K)
14500		K=L
14600		IF(R(6,K-1))R(6,K)=-R(6,K)
14700		R(8,K)=0
14800		GO TO 3634
14900	C  LOOPS BACK TO PICK UP MORE CHORD NOTES
15000	
15100	1634	T=POS1
15200		POS1=AB/Y*Z+POS1
15210		IF(JSET)GO TO 1636
15300		RP=6.
15400		IF(AMOD(R(5,K+1),10.0).EQ.0)RP=3.
15500	C  3 SPACES IF NO ACCID. ON NEXT NOTE, OTHERWISE 6.
15600		RA=POS1-T
15700		RSTX=RP*RSTJC
15800		IF(RA.GT.RSTX)GO TO 1636
15900	C  JUMP IF NOTES ARE FAR ENOUGH APART
16000		RA=RSTX-RA
16100	C  THE DIFFERENCE
16200		Z=Z-Z*RA/(POS2-POS1)
16300	C  REDUCES TOTAL SIZE Z 
16400		POS1=T+RSTX
16500	1636	T=0
16600		AB=AB-RB
16700		DO 534 N=1,4
16800	534	IF(AB.LE.RHY(N))T=N
16900		IF(AB.GE.4.)R(5,K)=AMOD(R(5,K),10.0)
17000	C  DELETES STEM FROM WHOLE NOTES.
17100		R(7,JZ)=T+R(7,JZ)
17200		IF(R(1,JZ).EQ.1.)GO TO 334
17300		R(4,JZ)=0
17400		IF(AB.EQ.4.)T=-2.
17500		IF(AB.EQ.2.)T=-1.
17600		R(5,JZ)=T
17700	C  OMITS RESTS  (REALLY???)
17800	334	IF(K.LT.IZ)GO TO 3
17810		DO 335 K=IZ,1,-1
17820		IF(R(2,K).GE.0)GO TO 335
17825		IF(K.NE.IZ)GO TO 336
17827		R(2,K)=POS2-4.
17829		GO TO 335
17830	336	R(2,K)=R(2,K+1)-4.
17840	335	CONTINUE
17900		IF(JSET.OR.SET4.GE.0)RETURN
17905		M=IZ
17907		RA=-1
17910		DO 23 K=1,IZ
17915		M=M+1
17917		IF(R(2,K).NE.RA.AND.ABS(R(4,K)).LT.100)GO TO 123
17918		M=M-1
17919		GO TO 23
17920	123	RA=R(2,K)
17921	C  TO CATCH DBL STOPS AND MINI-NOTES
17924		DO 323 L=1,8
17930	323	R(L,M)=R(L,K)
17935		R(3,M)=4
17945		R(8,K)=0
17960	23	CONTINUE
17970		IZ=M
17980	C ABOVE SETS UP STAFF 4 IF IT WASN'T ALREADY
17990		END
18000	
18100	C  SETUP ALLOWS YOU TO SET UP RHYTHMS ON STAFF 4 FOR SPACING ALL OTHERS.
18200		SUBROUTINE SETUP
18500		DIMENSION RPOS(2,40)
18600		COMMON/SCM/V(78),IV,LCNT,STAFF,LIST(200),REND
18700		COMMON /XRN/RN(4000)
18800		COMMON /PTR/PWDS(250),ITEM,L,I,IX
19100		EQUIVALENCE (RPOS(1,1),RN(3921)),(RA,RN(3919))
19200	
19300	C  ONLY DUPLE RHYTHMS MAY BE USED.  SINGLE DOTS CAN BE USED.
19310		RPOS(1,1)=-1.
19320		IF(STAFF.EQ.4)RETURN
19400		JX=0
19600		RA=0
19700		DO 9534 K=1,ITEM
19800		L=PWDS(K)
20200	      IF(RN(L+3).NE.4.)GO TO 9534
20400		RD=RN(L+1)
20450		IF(RD.EQ.10)GO TO 9534
20500		JX=JX+1
20600		RPOS(1,JX)=RN(L+2)
20700		IF(RD.GT.2)GO TO 3
20710	7	IF(RN(L+8))GO TO 177
20800		RB=0
20900		IF(RN(L+5).GE.10)GO TO 31
21000		RC=4.
21100		GO TO 131
21200	31	RB=RN(L+7)
21300		IF(RN(L+6).LT.0)GO TO 231
21400		RC=1./2**AMOD(RB,10.)
21500		GO TO 131
21600	231	RC=2.
21700	131	IF(RB.GT.9.)RC=RC*1.5
21710	277	RA=RA+RC
21720	C  SUM OF RHYTHS
21800		GO TO 77
21810	177	RC=-RN(L+8)
21815	C  FOR VALUES AUTOMATICALLY SET. ALLOWS NON-DUPLE UNITS IN SETUP
21820		GO TO 277
21900	3	RC=-RD
22000	77	RPOS(2,JX)=RC
22100	C  RC IS RHYTHMIC VALUE OF NOTE.
22200	9534	CONTINUE
22300	C  NEXT PUTS ITEMS IN PROPER ORDER IF THEY WEREN'T ALREADY
22400		IF(JX.EQ.0)RETURN
22500		CALL SORT2(RPOS,JX)
22510		DO 1 L=1,JX
22800	1	IF(RPOS(2,L).GT.0)GO TO 4
22910	4	RD=RPOS(1,L)
23000		RB=200-RD
23100	C  TOTAL SPACE FROM 1ST NOTE TO END OF LINE
23150		RC=RPOS(2,L)
23200		RPOS(2,L)=RD
23300	C REAL AND AVERAGED POSITIONS OF 1ST NOTE ARE THE SAME.
23400		DO 2 K=L+1,JX
23450		RE=RPOS(2,K)
23460		IF(RE)GO TO 2
23490		RD=RC/RA*RB+RD
23492		RC=RE
23495		RPOS(2,K)=RD
23510	2	CONTINUE
23600	C  1,K=REAL POS.    2,K=AVERAGED POS.
23700	C   IN RHYTH:  POS=(P1-AVG2)*(RL2-RL1)/(AVG2-AVG1)+RL1
23800		JX=JX+1
23900		RPOS(1,JX)=200.
24000		RPOS(2,JX)=200
24100		END
34000		SUBROUTINE MARKS(RA)
34100		COMMON/ALF/INP(72),ML
34200		DIMENSION MKS(9)
34300		DATA MKS/'W','A','F','S','M','T','D','U','H'/
34400		EQUIVALENCE (M3,MKS(3)),(M9,MKS(9))
34500		RA=99
34600		DO 16 JM=1,72
34700	16	IF(INP(JM))GO TO 17
34800	C  DIDN'T FIND  MORE LETTERS
34900		RETURN
35000	17	N=INP(JM)
35100		ML=INP(JM+1)
35200		M=INP(JM+2)
35300		DO 1 K=1,9
35400	1	IF(N.EQ.MKS(K))GO TO 2
35500	C  DID NOT FIND A LETTER
35600		RETURN
35700	2	GO TO(12,10,12,12,4,11,15,15,15),K
35800	15	K=K+1
35900	12	K=K+3
36000	8	RA=K
36100	C  YOU CAN TYPE # OR NAME OF MARK
36200		DO 6 JM=1,72
36300		N=INP(JM)
36400		INP(JM)=' '
36500	C  BLANKS OUT USED LETTERS
36600	6	IF(N.EQ.'/'.OR.N.EQ.'*'.OR.N.EQ.';')RETURN
36700	4	K=21
36800		IF(ML.NE.M3)GO TO 8
36900	18	K=K+1
37000		GO TO 8
37100	5	K=14
37200		GO TO 8
37300	10	IF(ML.EQ.'R')K=13
37400	C  'R' FOR ARSIS
37500		GO TO 12
37600	11	IF(ML.EQ.M9)K=12
37700	C THESIS
37800		GO TO 12
37900		END